home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / LIBRARY / PAS_0793 / CRYPT.PAS < prev    next >
Pascal/Delphi Source File  |  1993-08-01  |  2KB  |  87 lines
  1. {─ Fido Pascal Conference ────────────────────────────────────────────── PASCAL ─
  2. Msg  : 366 of 394
  3. From : David Drzyzga                       1:3612/220.0         04 Jul 93  18:23
  4. To   : All
  5. Subj : Encryption
  6. ────────────────────────────────────────────────────────────────────────────────
  7. Thaere hasn't been much on this subject for the last couple of weeks, but here
  8. is an encryption/decryption scheme that would be very difficult to crack:}
  9.  
  10. {------------------------------------------------------------------------------
  11.      Original source code by David Drzyzga, FidoNet 1:3612/220, SysOp of
  12.                   =>> CUTTER JOHN'S <<= (904) 932-1849 [HST]
  13.                                   07-04-1993
  14. ------------------------------------------------------------------------------}
  15.  
  16. program crypt;
  17.  
  18. uses
  19.   crt;
  20.  
  21. var
  22.   Index,
  23.   UserKey     : longint;
  24.   NumRead,
  25.   NumWritten  : word;
  26.   InFile,
  27.   OutFile     : file;
  28.   InFileName,
  29.   OutFileName : string[79];
  30.   Buffer      : array[1..51200] of char;
  31.   NumStr      : string[10];
  32.   Ch          : char;
  33.   Error       : integer;
  34.  
  35. function crypt(ch:char):char;
  36. var
  37.   UserKey_byte : byte;
  38. begin
  39.   UserKey_byte := UserKey shr 24;
  40.   crypt := chr(ord(ch) xor ord(UserKey_byte));
  41.   UserKey := $63C5 * UserKey + $A561;
  42.   {The two constants above can be changed but must be prime #s}
  43. end;
  44.  
  45. begin
  46.   clrscr;
  47.  
  48.   write('Enter FileName to En/Decrypt: ');
  49.   readln(InFileName);
  50.   assign(InFile, InFileName);
  51.   {$I-} reset(InFile,1); {$I+}
  52.   if IOResult <> 0 then begin
  53.     writeln('Input file does not exist');
  54.     halt;
  55.   end;
  56.  
  57.   write('Enter output fileName: ');
  58.   readln(OutFileName);
  59.   if InFileName = OutFileName then begin
  60.     writeln('Input file and output file must be different');
  61.     halt;
  62.   end;
  63.   assign(OutFile, OutFileName);
  64.   rewrite(OutFile, 1);
  65.  
  66.   write('Enter a numeric encription key between 1 and 2-billion: ');
  67.   NumStr := '';
  68.   repeat
  69.     Ch := readkey;
  70.     if Ch in ['0'..'9'] then begin
  71.       write(Ch);
  72.       NumStr := NumStr + Ch;
  73.     end;
  74.   until (length(NumStr) = 10) or (Ch = #13);
  75.   val(NumStr,UserKey,Error);
  76.  
  77.   writeln(#10#13'En/Decrypting file ...');
  78.   repeat
  79.     blockread(InFile, Buffer, sizeof(Buffer), NumRead);
  80.     for Index := 1 to NumRead do
  81.       Buffer[Index] := crypt(Buffer[Index]);
  82.     blockwrite(OutFile, Buffer, NumRead, NumWritten);
  83.   until (NumRead = 0) or (NumWritten <> NumRead);
  84.  
  85.   close(InFile);
  86.   close(OutFile);
  87. end.